﻿
;判断是否为闰年
Procedure IsLeapYear(Year)
  ProcedureReturn  Bool(Year % 400 = 0 Or (Year % 4 = 0 And Year % 100))
EndProcedure

;计算日期的总天数
Procedure YearGetAllDay(Year,Month,Day)
  Month-1
  Year + Month / 12-1
  Month % 12
  ProcedureReturn Year * 365 + Year / 4 - Year /100 + Year /400 + PeekL(?MonthData + Month * 4)+ Day-1 + Bool(Month > 1 And  IsLeapYear(Year+1)) 
EndProcedure

;从总天数中获得年份
Procedure AllDayGetYear(AllDay)
  TempAllDay=AllDay
  Repeat
     Year= TempAllDay / 365
     TempDay=YearGetAllDay(Year,1,1)
     Day = AllDay-TempDay
     TempAllDay+Day 
  Until Day >- 365 And Day < 365 
  If Day < 0 
   Year-1
  EndIf 
  ProcedureReturn Year
EndProcedure

;从总天数中获得月份
Procedure AllDayGetMonth(AllDay)
 Year = AllDayGetYear(AllDay)
 AllDay-YearGetAllDay(Year,1,1)+1
 If IsLeapYear(Year)
   If AllDay>335
     ProcedureReturn 12
   ElseIf AllDay>305
     ProcedureReturn 11
   ElseIf AllDay>274
     ProcedureReturn 10
   ElseIf AllDay>244
     ProcedureReturn 9
   ElseIf AllDay>213
     ProcedureReturn 8
   ElseIf AllDay>182
     ProcedureReturn 7
   ElseIf AllDay>152
     ProcedureReturn 6
   ElseIf AllDay>121
     ProcedureReturn 5
   ElseIf AllDay>91
     ProcedureReturn 4
   ElseIf AllDay>60
     ProcedureReturn 3
   ElseIf AllDay>31
     ProcedureReturn 2
   Else
     ProcedureReturn 1
   EndIf
 Else 
   If AllDay>334
     ProcedureReturn 12
   ElseIf AllDay>304
     ProcedureReturn 11
   ElseIf AllDay>273
     ProcedureReturn 10
   ElseIf AllDay>243
     ProcedureReturn 9
   ElseIf AllDay>212
     ProcedureReturn 8
   ElseIf AllDay>181
     ProcedureReturn 7
   ElseIf AllDay>151
     ProcedureReturn 6
   ElseIf AllDay>120
     ProcedureReturn 5
   ElseIf AllDay>90
     ProcedureReturn 4
   ElseIf AllDay>59
     ProcedureReturn 3
   ElseIf AllDay>31
     ProcedureReturn 2
   Else
     ProcedureReturn 1
   EndIf
EndIf 
EndProcedure

;从总天数中获得号数
Procedure AllDayGetDay(AllDay)
  ProcedureReturn AllDay-YearGetAllDay(AllDayGetYear(AllDay),AllDayGetMonth(AllDay),1)+1
EndProcedure

;获得星期
Procedure Weekday(Year,Month,Day)
  AllDay=YearGetAllDay(Year,Month,Day) + 1
  ProcedureReturn AllDay % 7
EndProcedure 

;传回农历 y年m月的总天数
Procedure lGetMonthDays(Year,Month)
  LunarInfo=PeekL(?LunarInfo+(Year - 1900)*4)
  PowMonth=$10000/(Pow(2,Month))
  If LunarInfo & PowMonth
     ProcedureReturn 30
  Else 
     ProcedureReturn 29
  EndIf 
EndProcedure

;传回农历 y年闰哪月 1-12 , 没闰传回 0
Procedure LGetMonth(Year)
 ProcedureReturn PeekL(?LunarInfo+(Year - 1900)*4) & $F 
EndProcedure

;传回农历y年闰月的天数
Procedure LGetDay(Year)
  If LGetMonth(Year)
      LunarInfo=PeekL(?LunarInfo+(Year - 1900)*4)
      If LunarInfo<0
         LunarInfo * -1
      EndIf
      If LunarInfo & $10000
        ProcedureReturn 30
      Else 
        ProcedureReturn 29
      EndIf 
  EndIf 
EndProcedure

;传回农历y年的总天数
Procedure LGetAllDay(Year)
 For M=1 To 12
   Sum+lGetMonthDays(Year,M)
 Next 
 ProcedureReturn Sum + LGetDay(Year)
EndProcedure

;传回阳历 y年某m月的天数
Procedure SolarDays(Year,Month)
  If Month=2 
    If IsLeapYear(Year)
      ProcedureReturn 29
    Else 
      ProcedureReturn 30
    EndIf 
  Else
    ProcedureReturn  PeekL(?MonthData + Month * 4)-PeekL(?MonthData + (Month-1) * 4)
  EndIf 
EndProcedure

;根据给定的阳历返回农历的日期
Procedure.d GetLunarNewYear(Year,Month,Day)
  SolarDate=YearGetAllDay(Year,Month,Day)
  If  SolarDate <=YearGetAllDay(2000,2,5)
    DaysOffset=SolarDate-YearGetAllDay(1900,1,31)
    I=1900
    While I<2001 And DaysOffset>=0
      Temp = LGetAllDay(I)
      DaysOffset-Temp
      I + 1
    Wend
    If DaysOffset <0 
      DaysOffset + Temp
      I-1
    EndIf 
    LYear=I
  Else 
    DaysOffset=SolarDate-YearGetAllDay(2000,2,5)
    I=2000
    While I<2091 And DaysOffset>=0
      Temp = LGetAllDay(I)
      DaysOffset-Temp
      I + 1
    Wend
    If DaysOffset <0 
      DaysOffset + Temp
      I-1
    EndIf 
    LYear=I
  EndIf 
  
  Leap = LGetMonth(i)
  IsLeap = #False
  I=1
  While I<13 And DaysOffset > 0
    If Leap > 0 And I = Leap + 1 And IsLeap = #False
      I-1
      IsLeap = #True
      Temp = LGetDay(lyear)
    Else 
      Temp = lGetMonthDays(lyear, i)
    EndIf 
    If IsLeap And i = Leap + 1
      IsLeap = #False
    EndIf 
    DaysOffset = DaysOffset - Temp
    I+1
  Wend
  If DaysOffset = 0 And Leap > 0 And i = Leap + 1 
    If IsLeap 
      IsLeap = #False
    Else
      IsLeap = #True
      i - 1
    EndIf
  EndIf 
  If DaysOffset < 0  
    DaysOffset + Temp
    i - 1
  EndIf
  lmonth = i
  lday = DaysOffset + 1
  PokeC(@LAllDay.d,lyear)
  PokeC(@LAllDay.d+2,lmonth)
  PokeC(@LAllDay.d+4,lday)
  PokeC(@LAllDay.d+6,IsLeap)
  ProcedureReturn LAllDay
EndProcedure

;将年份用天干地支表示
Procedure.s GetChineseEra(LYear)
  ProcedureReturn PeekS(?TeianZhi+ ((LYear + 6) % 10)*2,1,#PB_Unicode) +  PeekS(?DiZhi+ ((LYear + 8) % 12)*2,1,#PB_Unicode)
EndProcedure

;获得生肖
Procedure.s GetAnimal(LYear)
 ProcedureReturn PeekS(?ShenXiao+ ((LYear + 8) % 12)*2,1,#PB_Unicode)
EndProcedure

;将月份用农历表示
Procedure.s GetChineseMonth(LMonth)
  If LMonth < 10 
    ProcedureReturn PeekS(?ShuZhi+ LMonth*2,1,#PB_Unicode)+"月"
  Else 
    ProcedureReturn "十"+ PeekS(?ShuZhi+ (LMonth % 10)*2,1,#PB_Unicode) +"月"
  EndIf 
EndProcedure

;将月份用农历日期
Procedure.s GetChineseDay(Day)
  If Day < 11
     ProcedureReturn "初" + PeekS(?ShuZhi+Day*2,1,#PB_Unicode)
  ElseIf Day < 20
     ProcedureReturn "十" + PeekS(?ShuZhi+(Day % 10)*2,1,#PB_Unicode)
  ElseIf Day = 20
     ProcedureReturn "二十"
  ElseIf Day < 30
     ProcedureReturn "廿" + PeekS(?ShuZhi+(Day % 10)*2,1,#PB_Unicode)
  EndIf 
  ProcedureReturn "三十"
EndProcedure

;某y年的第n个节气的日期(从1小寒起算)
Procedure LTerm(LYear,n)
  D2.d = 31556925.9747 * (LYear - 1900) + PeekL(?sTermInfo + N * 4) * 60.0 -2208549300.0
  ProcedureReturn Round((62135596800.0 +D2)/86400.0, #PB_Round_Down)
EndProcedure

;根据阳历返回节气，若不是则返回空
Procedure.s GetSolarTerm(Year,Month,Day)
  AllDay=YearGetAllDay(Year,Month,Day)
  If LTerm(Year,Month * 2 -1) = AllDay
     ProcedureReturn PeekS(?SolarTerm + (Month * 2 - 1) * 4, 2, #PB_Unicode)
  ElseIf LTerm(Year,Month * 2) = AllDay
     ProcedureReturn PeekS(?SolarTerm + (Month * 2 ) * 4, 2, #PB_Unicode)
  EndIf 
EndProcedure

;返回阳历是该月的第几个星期几的字符串，如:0520表示5月份第2个星期日
Procedure WhichWeek(Year,Month,Day)
  PokeB(@Week.l,Weekday(Year,Month,Day))
  PokeB(@Week.l + 2,(Day + Weekday(Year,Month,1))/7)
  ProcedureReturn Week
EndProcedure

;获得阳历节日
Procedure.s GetsFtv(Month,Day)
  Datas.s=RSet(Str(Month),2,"0")+RSet(Str(Day),2,"0")
  Restore sFtv
  For I=1 To 101
    Read.s a.s
    If Left(a,4) = Datas
      Ftvs.s+Right(a,Len(a)-4)
    EndIf 
  Next 
  ProcedureReturn Ftvs
EndProcedure

;获得阴历节日
Procedure.s GetlFtv(Month,Day)
  Datas.s=RSet(Str(Month),2,"0")+RSet(Str(Day),2,"0")
  Restore lFtv
  For I=1 To 10
    Read.s a.s
    If Left(a,4) = Datas
      Ftvs.s+Right(a,Len(a)-4)
    EndIf 
  Next 
  ProcedureReturn Ftvs
EndProcedure

;获得星期节日
Procedure.s GetwFtv(Year,Month,Day)
  Week.l=WhichWeek(Year,Month,Day)
  Datas.s=RSet(Str(Month),2,"0")+Str(PeekB(@Week+2))+Str(PeekB(@Week))
  Restore wFtv
  For I=1 To 16
    Read.s a.s
    If Left(a,4) = Datas
      Ftvs.s+Right(a,Len(a)-4)
    EndIf 
  Next 
  ProcedureReturn Ftvs
EndProcedure

;获得黑色星期天的日期
Procedure GetEaster(Year)
  n = Year - 1900
  a = n % 19
  m = (11 * a + 4 - (7 * a + 1) / 19) % 29
  d = 25 - m - (n + n / 4 + 31 - m) % 7
  If d > 0 
    ProcedureReturn YearGetAllDay(Year,4,d) 
  ElseIf d=0 
    ProcedureReturn YearGetAllDay(Year,3,31) 
  Else
    ProcedureReturn YearGetAllDay(Year,3,31 + d)
  EndIf 
EndProcedure

;获得星座
Procedure.s GetAstrology(Month,Day)
 Te.l=Month * 100 + Day
 If Te >= 120 
   If Te <= 218
     ProcedureReturn "水瓶座"
   ElseIf Te <= 320
     ProcedureReturn "双鱼座"
   ElseIf Te <= 419
     ProcedureReturn "牡羊座"
   ElseIf Te <= 520
     ProcedureReturn "金牛座"
   ElseIf Te <= 621
     ProcedureReturn "双子座" 
   ElseIf Te <= 722
     ProcedureReturn "巨蟹座"
   ElseIf Te <= 822
     ProcedureReturn "狮子座"
   ElseIf Te <= 922
     ProcedureReturn "处女座"
   ElseIf Te <= 1023
     ProcedureReturn "天秤座"
   ElseIf Te <= 1121
     ProcedureReturn "天蝎座"
   ElseIf Te <= 1231
     ProcedureReturn "魔羯座"
   EndIf 
 Else
    ProcedureReturn "魔羯座"
 EndIf 
EndProcedure

;从阴历获得阴历
Procedure GetSolar(LYear,LMonth,LDay)
  AllDay=LDay + 694008 ;YearGetAllDay(1900,12,31)
  For Y=1901 To LYear-1
    AllDay + LGetAllDay(Y)
  Next 
  For Y=1 To LMonth-1
    AllDay + lGetMonthDays(LYear,Y)
  Next 
  If LMonth > LGetMonth(LYear)
    AllDay + LGetDay(LYear)
  EndIf 
  ProcedureReturn AllDay
EndProcedure

DataSection
TeianZhi:
   Data.s "甲乙丙丁戊己庚辛壬癸"
DiZhi:
   Data.s "子丑寅卯辰巳午未申酉戌亥"
ShenXiao:
   Data.s "鼠牛虎兔龙蛇马羊猴鸡狗猪"
ShuZhi:
   Data.c ""
   Data.s "一二三四五六七八九十"

MonthData:
   Data.l 0,31,59,90,120,151,181,212,243,273,304,334
sTermInfo:
   Data.l 000000
   Data.l 000000,021208,042467,063836,085337,107014
   Data.l 128867,150921,173149,195551,218072,240693
   Data.l 263343,285989,308563,331033,353350,375494
   Data.l 397447,419210,440795,462224,483532,504758
SolarTerm:
   Data.s "  小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至"

LunarInfo:
   Data.l $4BD8,$4AE0,$A570,$54D5,$D260,$D950
   Data.l $16554,$56A0,$9AD0,$55D2,$4AE0,$A5B6
   Data.l $A4D0,$D250,$1D255,$B540,$D6A0,$ADA2
   Data.l $95B0,$14977,$4970,$A4B0,$B4B5,$6A50
   Data.l $6D40,$1AB54,$2B60,$9570,$52F2,$4970
   Data.l $6566,$D4A0,$EA50,$6E95,$5AD0,$2B60
   Data.l $186E3,$92E0,$1C8D7,$C950,$D4A0,$1D8A6
   Data.l $B550,$56A0,$1A5B4,$25D0,$92D0,$D2B2
   Data.l $A950,$B557,$6CA0,$B550,$15355,$4DA0
   Data.l $A5D0,$14573,$52D0,$A9A8,$E950,$6AA0
   Data.l $AEA6,$AB50,$4B60,$AAE4,$A570,$5260
   Data.l $F263,$D950,$5B57,$56A0,$96D0,$4DD5
   Data.l $4AD0,$A4D0,$D4D4,$D250,$D558,$B540
   Data.l $B5A0,$195A6,$95B0,$49B0,$A974,$A4B0
   Data.l $B27A,$6A50,$6D40,$AF46,$AB60,$9570
   Data.l $4AF5,$4970,$64B0,$74A3,$EA50,$6B58
   Data.l $55C0,$AB60,$96D5,$92E0,$C960,$D954
   Data.l $D4A0,$DA50,$7552,$56A0,$ABB7,$25D0
   Data.l $92D0,$CAB5,$A950,$B4A0,$BAA4,$AD50
   Data.l $55D9,$4BA0,$A5B0,$15176,$52B0,$A930
   Data.l $7954,$6AA0,$AD50,$5B52,$4B60,$A6E6
   Data.l $A4E0,$D260,$EA65,$D530,$5AA0,$76A3
   Data.l $96D0,$4BD7,$4AD0,$A4D0,$1D0B6,$D250
   Data.l $D520,$DD45,$B5A0,$56D0,$55B2,$49B0
   Data.l $A577,$A4B0,$AA50,$1B255,$6D20,$ADA0
   Data.l $14B63,$9370,$49F8,$4970,$64B0,$168A6
   Data.l $EA50,$6B20,$1A6C4,$AAE0,$92E0,$D2E3
   Data.l $C960,$D557,$D4A0,$DA50,$5D55,$56A0
   Data.l $A6D0,$55D4,$52D0,$A9B8,$A950,$B4A0
   Data.l $B6A6,$AD50,$55A0,$ABA4,$A5B0,$52B0
   Data.l $B273,$6930,$7337,$6A60,$AD50,$6B55
   Data.l $4B60,$A570,$54E4,$D160,$E968
sFtv:
   Data.s "0101元旦节"
   Data.s "0202世界湿地日"
   Data.s "0210国际气象节"
   Data.s "0214情人节"
   Data.s "0301国际海豹日"
   Data.s "0303全国爱耳日"
   Data.s "0305学雷锋纪念日"
   Data.s "0308妇女节"
   Data.s "0312植树节 孙中山逝世纪念日"
   Data.s "0314国际警察日"
   Data.s "0315消费者权益日"
   Data.s "0317中国国医节 国际航海日"
   Data.s "0321世界森林日 消除种族歧视国际日 世界儿歌日"
   Data.s "0322世界水日"
   Data.s "0323世界气象日"
   Data.s "0324世界防治结核病日"
   Data.s "0325全国中小学生安全教育日"
   Data.s "0330巴勒斯坦国土日"
   Data.s "0401愚人节 全国爱国卫生运动月(四月) 税收宣传月(四月)"
   Data.s "0407世界卫生日"
   Data.s "0422世界地球日"
   Data.s "0423世界图书和版权日"
   Data.s "0424亚非新闻工作者日"
   Data.s "0501劳动节"
   Data.s "0502劳动节假日"
   Data.s "0503劳动节假日"
   Data.s "0504青年节"
   Data.s "0505碘缺乏病防治日"
   Data.s "0508世界红十字日"
   Data.s "0512国际护士节"
   Data.s "0515国际家庭日"
   Data.s "0517国际电信日"
   Data.s "0518国际博物馆日"
   Data.s "0520全国学生营养日"
   Data.s "0523国际牛奶日"
   Data.s "0531世界无烟日"
   Data.s "0601国际儿童节"
   Data.s "0605世界环境保护日"
   Data.s "0606全国爱眼日"
   Data.s "0617防治荒漠化和干旱日"
   Data.s "0623国际奥林匹克日"
   Data.s "0625全国土地日"
   Data.s "0626国际禁毒日"
   Data.s "0701香港回归纪念日 中共诞辰 世界建筑日"
   Data.s "0702国际体育记者日"
   Data.s "0707抗日战争纪念日"
   Data.s "0711世界人口日"
   Data.s "0730非洲妇女日"
   Data.s "0801建军节"
   Data.s "0808中国男子节(爸爸节)"
   Data.s "0815抗日战争胜利纪念"
   Data.s "0908国际扫盲日 国际新闻工作者日"
   Data.s "0909毛泽东逝世纪念"
   Data.s "0910中国教师节"
   Data.s "0914世界清洁地球日"
   Data.s "0916国际臭氧层保护日"
   Data.s "0918九·一八事变纪念日"
   Data.s "0920国际爱牙日"
   Data.s "0927世界旅游日"
   Data.s "0928孔子诞辰"
   Data.s "1001国庆节 世界音乐日 国际老人节"
   Data.s "1002国庆节假日 国际和平与民主自由斗争日"
   Data.s "1003国庆节假日"
   Data.s "1004世界动物日"
   Data.s "1006老人节"
   Data.s "1008全国高血压日 世界视觉日"
   Data.s "1009世界邮政日 万国邮联日"
   Data.s "1010辛亥革命纪念日 世界精神卫生日"
   Data.s "1013世界保健日 国际教师节,"
   Data.s "1014世界标准日"
   Data.s "1015国际盲人节(白手杖节)"
   Data.s "1016世界粮食日"
   Data.s "1017世界消除贫困日"
   Data.s "1022世界传统医药日"
   Data.s "1024联合国日"
   Data.s "1031世界勤俭日"
   Data.s "1107十月社会主义革命纪念日"
   Data.s "1108中国记者日"
   Data.s "1109全国消防安全宣传教育日"
   Data.s "1110世界青年节"
   Data.s "1111国际科学与和平周(本日所属的一周)"
   Data.s "1112孙中山诞辰纪念日"
   Data.s "1114世界糖尿病日"
   Data.s "1117国际大学生节 世界学生节"
   Data.s "1120彝族年"
   Data.s "1121彝族年 世界问候日 世界电视日"
   Data.s "1122彝族年"
   Data.s "1129国际声援巴勒斯坦人民国际日"
   Data.s "1201世界艾滋病日"
   Data.s "1203世界残疾人日"
   Data.s "1205国际经济和社会发展志愿人员日"
   Data.s "1208国际儿童电视日"
   Data.s "1209世界足球日"
   Data.s "1210世界人权日"
   Data.s "1212西安事变纪念日"
   Data.s "1213南京大屠杀(1937年)纪念日！紧记血泪史！"
   Data.s "1220澳门回归纪念"
   Data.s "1221国际篮球日"
   Data.s "1224平安夜"
   Data.s "1225圣诞节"
   Data.s "1226毛泽东诞辰纪念"
lFtv:
   Data.s "0101春节"
   Data.s "0115元宵节"
   Data.s "0505端午节"
   Data.s "0707七夕情人节"
   Data.s "0715中元节"
   Data.s "0815中秋节"
   Data.s "0909重阳节"
   Data.s "1208腊八节"
   Data.s "1223小年"
   Data.s "0100除夕"
wFtv:
   Data.s "0150世界麻风日"
   Data.s "0520国际母亲节"
   Data.s "0530全国助残日"
   Data.s "0630父亲节"
   Data.s "0730被奴役国家周"
   Data.s "0932国际和平日"
   Data.s "0940国际聋人节 世界儿童日"
   Data.s "0950世界海事日"
   Data.s "1011国际住房日"
   Data.s "1013国际减轻自然灾害日(减灾日)"
   Data.s "1144感恩节"
   Data.s "0231总统日"
   Data.s "0531胜利日"
   Data.s "0716合作节"
   Data.s "0730被奴周"
   Data.s "1021哥伦布日"
EndDataSection




; IDE Options = PureBasic 5.11 (Windows - x86)
; CursorPosition = 8
; Folding = DgAQ9----
; EnableAsm
; EnableUnicode
; EnableXP
; Executable = ..\d.exe
; EnableExeConstant